home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / multifld.zip / MULTIFLD.BAS < prev    next >
BASIC Source File  |  1992-01-03  |  23KB  |  826 lines
  1. 'I think many QB programmers will find this routine usefull. I wrote it
  2. 'because I HAD to have it. QUICKLY. Having recieved so much good stuff from
  3. 'QuickShare, I figure this small donation is the least I can do for now.
  4. 'I have since this was written, refined this and other high level routines
  5. 'which I will eventually make available at the usual cost - FREE.
  6. 'Use this code 'till your sick of it. It has served its purpose for me.
  7. 'Laugh at it 'till your gut hurts.
  8. 'When I wrote this, I threw it together from pieces parts of other
  9. 'things I had handy. It certainly is not optimized but it works fairly well.
  10. 'Jerry C. Jackson - Deland, Fl.
  11.   
  12.    DEFINT A-Z
  13.   
  14. ' Define color constants
  15.   
  16.    CONST black = 0
  17.    CONST blue = 1
  18.    CONST green = 2
  19.    CONST cyan = 3
  20.    CONST red = 4
  21.    CONST magenta = 5
  22.    CONST brown = 6
  23.    CONST white = 7
  24.    CONST bright = 8
  25.    CONST blink% = 16
  26.    CONST yellow = brown + bright
  27.   
  28. 'define constants used by the KeyCode% function CVI(a$ + STRING$(2, 0))
  29.    CONST FALSE = 0
  30.    CONST TRUE = NOT FALSE
  31.    CONST BACKSPACE = 8
  32.    CONST CTRLLEFTARROW = 29440
  33.    CONST CTRLRIGHTARROW = 29696
  34.    CONST CTRLY = 25
  35.    CONST CTRLQ = 17
  36.    CONST DEL = 21248
  37.    CONST ENDKEY = 20224
  38.    CONST ENTER = 13
  39.    CONST ESCAPE = 27
  40.    CONST HOME = 18176
  41.    CONST INSERTKEY = 20992
  42.    CONST UPARROW = 18432
  43.    CONST DOWNARROW = 20480
  44.    CONST LEFTARROW = 19200
  45.    CONST RIGHTARROW = 19712
  46.    CONST TABKEY = 9
  47.    CONST SHIFTTABKEY = 3840
  48.    CONST PGUP = 18688
  49.    CONST PGDN = 20736
  50.    CONST F10 = 17408
  51.    CONST CTRLHOME = 30464
  52.    CONST CTRLEND = 29952
  53.  
  54. 'define some more constants
  55.  
  56.    CONST illegal$ = "t255o0g64o2c64o0g64o2c64o0g64o2c64"
  57.    CONST fullfield$ = "t255o4g64o2c64o0g64o2c64o0g64o2c64"
  58.    CONST click$ = "t255o6c64"
  59.    CONST upperalpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  60.    CONST loweralpha$ = "abcdefghijklmnopqrstuvwxyz"
  61.    CONST decimal$ = "."
  62.    CONST number$ = "0123456789"
  63.    CONST otherkeys$ = "!@#$%^&*()-_=+[]{};':,./<>?\|`~"
  64.    CONST c32$ = " "
  65.   
  66.   
  67.    TYPE RegType
  68.       ax    AS INTEGER
  69.       bx    AS INTEGER
  70.       cx    AS INTEGER
  71.       dx    AS INTEGER
  72.       bp    AS INTEGER
  73.       si    AS INTEGER
  74.       di    AS INTEGER
  75.       flags AS INTEGER
  76.    END TYPE
  77.   
  78.   
  79. 'make arrays dynamic
  80. ' $DYNAMIC
  81.   
  82.    TYPE MultiFieldType
  83.      
  84.       edgeLine       AS INTEGER
  85.       ulrow          AS INTEGER
  86.       ulcol          AS INTEGER
  87.       lrrow          AS INTEGER
  88.       lrcol          AS INTEGER
  89.       fgedge         AS INTEGER
  90.       bgedge         AS INTEGER
  91.       fgbody         AS INTEGER
  92.       bgbody         AS INTEGER
  93.       fgNameActive       AS INTEGER
  94.       bgNameActive       AS INTEGER
  95.       fgNameInactive     AS INTEGER
  96.       bgNameInactive     AS INTEGER
  97.       fgValueActive  AS INTEGER
  98.       bgValueActive  AS INTEGER
  99.       fgValueInactive   AS INTEGER
  100.       bgValueInactive   AS INTEGER
  101.       fgtitle        AS INTEGER
  102.       bgtitle        AS INTEGER
  103.       fgPrompt       AS INTEGER
  104.       bgPrompt       AS INTEGER
  105.       fghelp         AS INTEGER
  106.       bghelp         AS INTEGER
  107.       rowhelp        AS INTEGER
  108.      
  109.    END TYPE
  110.   
  111.   
  112.    DECLARE FUNCTION KeyCode% ()
  113.    DECLARE FUNCTION EdKeyCode% ()
  114.   
  115.    DECLARE SUB EndProg ()
  116.    DECLARE SUB VideoState (mode%, columns%, page%)
  117.    DECLARE SUB EditCustomerInfo ()
  118.    DECLARE SUB MFI (mf AS MultiFieldType, mfFieldName$(), mfFieldCap%(), mfFieldValue$(), mfFieldMask$(), mfFieldLen%(), mfFieldPos(), mfFieldHelp$(), mfTitle$, mfPrompt$, mfScrollFileSpec$())
  119.    DECLARE SUB INTERRUPT (intnum%, inreg AS RegType, outreg AS RegType)
  120.    DECLARE SUB GetLinesInFile (filespec$, size%)
  121.    DECLARE SUB Hold ()
  122.    DECLARE SUB EndProgram ()
  123.    DECLARE SUB SetCursor (row%, col%, fc%, bc%)
  124.    DECLARE SUB MFIedit (a$, strlen%, mask$, extramask$, exitcode%, fg%, bg%)
  125.   
  126.   
  127.   
  128.    DIM SHARED allkeys$
  129.    allkeys$ = upperalpha$ + loweralpha$ + number$ + decimal$ + otherkeys$
  130.   
  131. 'get # of lines in file
  132.   
  133.    filespec$ = "0001.dat"
  134.    GetLinesInFile filespec$, n%
  135.    n% = n% - 15 'don't dimension anything for the file comment.
  136.   
  137. 'now that we know how big to dim the arrays, do it.
  138.    DIM SHARED mf1 AS MultiFieldType, mf1FieldName$(1 TO n%), mf1FieldCap%(1 TO n%), mf1FieldValue$(1 TO n%), mf1FieldMask$(1 TO n%, 1 TO 2), mf1FieldLen%(1 TO n%), mf1FieldPos%(1 TO n%, 1 TO 2), mf1FieldHelp$(1 TO n%), mf1Title$, mf1Prompt$,  _
  139. mf1ScrollFileSpec$(1 TO n%)
  140.   
  141.   
  142. 'don't get lost in video pages just yet
  143.    SCREEN , , 0, 0
  144.   
  145.    EditCustomerInfo
  146.   
  147.    EndProg
  148.   
  149.  
  150. REM $STATIC
  151.    SUB EditCustomerInfo
  152.      
  153.       filespec$ = "0001.dat"
  154.       GetLinesInFile filespec$, n%
  155.       n% = n% - 15   'don't count the file "header" as field items
  156.      
  157. 'field information is stored in data files to save memory
  158.      
  159.       filenum% = FREEFILE
  160.       OPEN filespec$ FOR INPUT AS filenum%
  161.      
  162.       FOR p2% = 1 TO 15         ''trash the file comments
  163.          LINE INPUT #1, trash$
  164.       NEXT p2%
  165.      
  166.       FOR p1% = 1 TO n%         'read the comma delimited data from the file
  167.          INPUT #1, t$, mf1FieldName$(p1%), mf1FieldHelp$(p1%), mf1FieldPos%(p1%, 1), mf1FieldPos%(p1%, 2), mf1FieldLen%(p1%), mf1FieldCap%(p1%), mf1FieldMask$(p1%, 1), mf1FieldMask$(p1%, 2), mf1ScrollFileSpec$(p1%)
  168.       NEXT p1%
  169.      
  170.       CLOSE filenum%
  171.      
  172.      
  173.      
  174. '--------------------------------------------------------------------------
  175. 'this stuff could also become part of the data file, but I got lazy <grin>
  176.      
  177.       mf1.edgeLine = 1
  178.       mf1.ulrow = 1
  179.       mf1.ulcol = 1
  180.       mf1.lrrow = 23
  181.       mf1.lrcol = 80
  182.       mf1.fgedge = cyan
  183.       mf1.bgedge = blue
  184.       mf1.fgbody = white
  185.       mf1.bgbody = black
  186.       mf1.fgtitle = yellow
  187.       mf1.bgtitle = blue
  188.       mf1.fgPrompt = yellow
  189.       mf1.bgPrompt = blue
  190.       mf1.fgNameActive = yellow
  191.       mf1.bgNameActive = red
  192.       mf1.fgNameInactive = green
  193.       mf1.bgNameInactive = black
  194.       mf1.fgValueActive = black
  195.       mf1.bgValueActive = white
  196.       mf1.fgValueInactive = cyan + bright
  197.       mf1.bgValueInactive = black
  198.       mf1.rowhelp = 25
  199.       mf1.fghelp = cyan + bright
  200.       mf1.bghelp = blue
  201.       mf1Title$ = " Enter Customer / Vehicle Information Below "
  202.       mf1Prompt$ = " TAB / SHIFT-TAB to move between fields ■ F10 when finished "
  203.      
  204.       CLS
  205.      
  206. 'This is it! After you've read the info from disk and set the other variables
  207. 'all you do is call this routine and input to your hearts content.
  208. 'Play with the colors above and see how easy it is to make it look different.
  209. 'Play with the data file "0001.dat", but don't get the comma delimited
  210. 'data out of place.
  211.      
  212.       MFI mf1, mf1FieldName$(), mf1FieldCap%(), mf1FieldValue$(), mf1FieldMask$(), mf1FieldLen%(), mf1FieldPos%(), mf1FieldHelp$(), mf1Title$, mf1Prompt$, mf1ScrollFileSpec$()
  213.      
  214.      
  215.       SCREEN , , 0, 0
  216.      
  217.    END SUB
  218.  
  219. DEFSNG A-Z
  220.    FUNCTION EdKeyCode% STATIC
  221.      
  222.       DO
  223.          k$ = INKEY$
  224.       LOOP UNTIL k$ <> ""
  225.       EdKeyCode% = CVI(k$ + CHR$(0))
  226.      
  227.      
  228.      
  229.    END FUNCTION
  230.  
  231. DEFINT A-Z
  232. '
  233.    SUB EndProg
  234.  
  235. 'whatever code you need to clean up after yourself goes in here too.
  236.      
  237.       SCREEN , , 0, 0
  238.       COLOR 7, 0
  239.       CLS
  240.       END
  241.      
  242.      
  243.    END SUB
  244.  
  245. '
  246.    SUB GetLinesInFile (filespec$, size%)
  247.      
  248.      
  249. '---------------------------------------------------------------------------
  250. '
  251. '  This sub finds the exact size for the array dimension so that no memory
  252. '  gets wasted. A little less than elegant, but I was in a hurry.
  253. '
  254. '---------------------------------------------------------------------------
  255.      
  256.      
  257.       filenum% = FREEFILE
  258.       OPEN filespec$ FOR INPUT AS filenum%
  259.      
  260.       size% = 0
  261.      
  262.       DO WHILE NOT EOF(filenum%)
  263.          size% = size% + 1
  264.          LINE INPUT #1, test$
  265.       LOOP
  266.      
  267.       CLOSE filenum%
  268.      
  269.      
  270.      
  271.    END SUB
  272.  
  273.    SUB Hold
  274.       DO UNTIL LEN(INKEY$): LOOP
  275.    END SUB
  276.  
  277. DEFSNG A-Z
  278.    FUNCTION KeyCode% STATIC
  279.      
  280.       KeyCode% = CVI(INKEY$ + STRING$(2, 0))
  281.      
  282.    END FUNCTION
  283.